home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / convert.pas < prev    next >
Pascal/Delphi Source File  |  1987-02-22  |  7KB  |  211 lines
  1. PROGRAM PROG4(INPUT,OUTPUT);
  2. (****************************************************************)
  3. (*                                                              *)
  4. (*               WRITTEN BY: PETER J. KINSELLA                  *)
  5. (*    MOORHEAD MN                           (218) 233-8467      *)
  6. (*                          1/12/87                             *)
  7. (*                                                              *)
  8. (*                                                              *)
  9. (*      THIS PROGRAM WILL CONVERT INTEGERS BETWEEN ANY TWO      *)
  10. (*  BASES SPECIFIED BY THE USER.                                *)
  11. (*                                                              *)
  12. (*                                                              *)
  13. (*  INPUT:                                                      *)
  14. (*      WILL CONSIST OF A SEQENCE OF LINES, EACH LINE HAVING A  *)
  15. (*  SERIES OF NUMBERS ON IT, THE FIRST NUMBER (WHICH MUST BE    *)
  16. (*  LESS THEN 16) IS THE BASE (B1) THE PROGRAM IS TO CONVERT    *)
  17. (*  FROM, FOLLOWED BY AT LEAST ONE BLANK AND A SECOND NUMBER    *)
  18. (*  (ALSO LESS THEN 16) THE PROGRAM WILL CONVERT TO (B2).       *)
  19. (*      THESE TWO NUMBERS MUST BE FOLLOWED BUY AT LEAST ONE     *)
  20. (*  BLANK AND THEN A SEQUENCE OF CONSECUTIVE NON-BLANK          *)
  21. (*  CHARACTERS WILL FOLLOW REPRESENTING THE VALUE OF THE BASE   *)
  22. (*  TO BE CONVERTED.                                            *)
  23. (*                                                              *)
  24. (*                                                              *)
  25. (*  OUTPUT:                                                     *)
  26. (*      FOR EACH LINE OF INPUT AN OUT PUT LINE WILL BE WRITTEN  *)
  27. (*  SHOWING THE TWO BASES BEING CONVERTED BETWEEN ALONG WITH    *)
  28. (*  THE ORIGINAL AND CONVERTED VALUE OF THE NUMBER, OR SOME     *)
  29. (*  ERROR STATMENT GIVING SOME INDICATION AS TO WHY THE VALUE   *)
  30. (*  COULD NOT BE PROCESSED.                                     *)
  31. (*                                                              *)
  32. (*                                                              *)
  33. (*  ASSUMPTIONS:                                                *)
  34. (*      1. NO BASE WILL BE, OR CONVERTED TO LARGER THEN BASE 16 *)
  35. (*      2. NO NONE ALPHA-NUMERIC CHARACTERS WILL BE IN THE      *)
  36. (*           INPUT FILE.                                        *)
  37. (*      3. FOR LARGER THAN BASE 10 CONVERSIONS THIS PROGRAM     *)
  38. (*         SHOULD BE RUN ON AN EBCDIC OPERATING SYSTEM.         *)
  39. (*                                                              *)
  40. (****************************************************************)
  41.  
  42. VAR
  43.     BASE1:   INTEGER; (* VALUE OF BASE CONVERTING FROM *)
  44.     BASE2:   INTEGER; (*  VALUE OF BASE CONVERTING TO  *)
  45.     SUM:     INTEGER;
  46.     CH:      CHAR;
  47.     FLAG:    BOOLEAN; (* FALSE IF ERROR IN INPUT DATA  *)
  48.  
  49.  
  50.  
  51.  
  52. FUNCTION VALUE(VAR CH: CHAR) : INTEGER;
  53. (*******************************************************)
  54. (*  RETURNS BASE TEN EQUIVELENT OF NUMBER UP THROUGH F *)
  55. (*******************************************************)
  56.  
  57. BEGIN (* VALUE *)
  58.  
  59.  
  60.     VALUE:= ORD(CH) - ORD('0');
  61.  
  62.     IF (CH < '0' ) THEN
  63.         VALUE:= (ORD(CH) - ORD('A')) + 10;
  64.  
  65.  
  66. END; (* VALUE *)
  67.  
  68.  
  69.  
  70.  
  71. PROCEDURE TEST(VAR CH:CHAR; VAR BASE1,SUM:INTEGER; VAR FLAG:BOOLEAN);
  72. (*******************************************************)
  73. (*  CHECKS TO MAKE SURE CHARACTER IS A VALID NUMERIC   *)
  74. (*  INDICATOR.                                         *)
  75. (*******************************************************)
  76.  
  77.  
  78. BEGIN (* TEST *)
  79.  
  80.     IF ((MAXINT/(SUM+1)) > VALUE(CH)) THEN
  81.         FLAG :=FALSE;
  82.  
  83.     IF ((VALUE(CH) < BASE1) AND (VALUE(CH) >= 0)) THEN
  84.         FLAG := TRUE
  85.     ELSE
  86.         BEGIN
  87.            WRITE('*** DATA ERROR ***');
  88.            FLAG := FALSE;
  89.            WHILE CH <> ' ' DO
  90.              READ(CH);
  91.         END;
  92.  
  93.  
  94. END; (* TEST *)
  95.  
  96.  
  97.  
  98. PROCEDURE BASE10(VAR CH:CHAR; VAR BASE1, SUM:INTEGER; VAR FLAG:BOOLEAN);
  99. (*******************************************************)
  100. (*  CONVERTS A STIRING OF CHARACTERS TO BASE 10        *)
  101. (*  EQUIVALENT THROUGH 'F'                             *)
  102. (*******************************************************)
  103.  
  104.  
  105.  
  106.  
  107. BEGIN (* BASE10 *)
  108.  
  109.     WHILE (CH <> ' ') DO
  110.         BEGIN
  111.         TEST(CH,BASE1,SUM,FLAG);
  112.         IF (FLAG) THEN
  113.            BEGIN
  114.              WRITE (CH);
  115.              SUM:= SUM * BASE1 + VALUE(CH);
  116.              READ (CH);
  117.            END
  118.         END;
  119.  
  120. END;  (* BASE10 *)
  121.  
  122.  
  123.  
  124.  
  125.  
  126. PROCEDURE CONVERT(VAR NUM, B2: INTEGER);
  127. (*******************************************************)
  128. (*  THIS PROCEDURE CONVERTS BASE 10 NUMBER'S TO BASE   *)
  129. (*  'B2' NUMBERS.                                      *)
  130. (*******************************************************)
  131.  
  132. VAR
  133.     I    : INTEGER; (* INDEX VARIABLE *)
  134.     DIGIT: INTEGER; (* DIGIT IN BASE 'B2' *)
  135.  
  136.  
  137.  
  138. FUNCTION POWER(VAR X, N :INTEGER):INTEGER;
  139. (********************************************************)
  140. (*  THIS FUNCTION RAISES THE BASE 'X' TO THE POWER 'N'  *)
  141. (********************************************************)
  142.  
  143.  
  144.     VAR
  145.         SUM, COUNT: INTEGER;
  146.  
  147. BEGIN (* POWER *)
  148.  
  149.     SUM := 1;
  150.     COUNT := 1;
  151.  
  152.     WHILE COUNT <= N DO
  153.         BEGIN
  154.            SUM := SUM * X;
  155.            COUNT := COUNT + 1
  156.         END;
  157.  
  158.     POWER := SUM
  159.  
  160. END; (* POWER *)
  161.  
  162.  
  163.  
  164.  
  165. BEGIN (* CONVERT *)
  166.  
  167.     I:= 0;
  168.  
  169.     WHILE (NOT(POWER(B2,I) > NUM)) DO
  170.         I := I + 1;
  171.  
  172.     WHILE I >= 1 DO
  173.         BEGIN
  174.            I := I - 1;
  175.            DIGIT := NUM DIV POWER(B2,I);
  176.            NUM := NUM MOD POWER(B2,I);
  177.            WRITE(DIGIT:1);
  178.         END;
  179.  
  180.     WRITELN;
  181.  
  182. END; (* CONVERT *)
  183.  
  184.  
  185.  
  186. BEGIN (* PROG4 *)
  187.  
  188. WHILE NOT EOF DO
  189.     BEGIN
  190.  
  191.         FLAG := TRUE;
  192.         SUM := 0;
  193.         READ(BASE1,BASE2);
  194.  
  195.         WRITE('BASE ',BASE1:2,' REPRESENTATION ');
  196.  
  197.         READ(CH);
  198.         WHILE ((CH = ' ') AND (NOT EOF)) DO
  199.            READ(CH);
  200.  
  201.         BASE10(CH, BASE1, SUM, FLAG);
  202.         IF (FLAG) THEN
  203.             BEGIN
  204.               WRITE('  BASE ',BASE2:2,' REPRESENTATION ');
  205.               CONVERT(SUM, BASE2);
  206.             END;
  207.  
  208.     END;
  209. END. (* PROG4 *)
  210.